#   Copyright 2013 Stacy Doss stacy.doss@gmail.com
#
#   Licensed under the Apache License, Version 2.0 (the "License");
#   you may not use this file except in compliance with the License.
#   You may obtain a copy of the License at
#
#       http://www.apache.org/licenses/LICENSE-2.0
#
#   Unless required by applicable law or agreed to in writing, software
#   distributed under the License is distributed on an "AS IS" BASIS,
#   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#   See the License for the specific language governing permissions and
#   limitations under the License.

package DIME::View::HList;

use strict;
use warnings;

use Data::Dumper;
use DIME::Utility;
use Storable qw(dclone);
use Tk::Hlist;
use Tk::ErrorDialog;

our $SEP = sprintf("%c", 1);

#    Tk::Error($self->{parent}{MW}, "Ouch!", Utility::__stack_trace());


sub new {

	my $class  = shift;
	my $parent = shift;
		
	my $T = {
        parent      => $parent,
        application => $parent->getApplication(),
        clipboard   => undef,
	};
		
	bless $T, $class;
    $T->frame();
    my $r = refType({});

	return $T;
}



sub add {
	my $self = shift;
	my $type = shift;

    my $selected = $self->{list}->info('selection'); 
 
    for my $selection (@{$selected}) {
        my $path = $self->getPath($selection);
        my $ref  = $self->getPathRef($path);

        my $key = $self->getEditValue('key');

        if (arrayref($ref)) {
            $key = scalar @{$ref};
        }

        unless (defined $key) {
            print STDERR "Can not 'add' to $selection, no key defined\n";
            return;
        }

        unless (ref($ref)) {
            print STDERR "Can not 'add' to $selection, not a container\n";
            return;
        }

        my $new = "$selection$SEP$key";
        my $value = $self->getEditValue('value');
        if ($type eq '@') {
            $value = [];
        } elsif ($type eq '%') {
            $value = {};
        }
        $self->addData($new, $value);
        $self->addListItem($new);
    }
}



sub addData {
	my $self  = shift;
	my $key   = shift;
    my $value = shift;    

    my $path   = $self->getPath($key);
    my $target = pop @{$path};
    
    my $ref = $self->getPathRef($path);

    if (hashref($ref)) {
        $ref->{$target} = $value;
    } elsif (arrayref($ref)) {
        $ref->[$target] = $value;
    } else {
        # A scalar cannot point to a scalar, therefore, the path must consist  
        # of either array or hash refs, if it doesn't, we have a problem
        print STDERR "Opps. Can not addData for $key\n";
    }
}



sub addListItem {
	my $self = shift;
	my $item = shift; # Key or ndx

    # Why explicatly add when it already exists?
	return if $self->{list}->info('exists', $item);

    my $path = $self->getPath($item);
    my $ref  = $self->getPathRef($path);
    my $key  = pop @{$path};
    
    # By default adds to tail of parent and is closed
	$self->{list}->add($item, 
	                   -text  => $key, 
	                   -state => 'close',
	                   -image => $self->{parent}->getIcon('close', DIME::refType($ref)));

    $self->refreshValueColumn($item, $ref);
}



# L@@K this may need to be replaced with an apply button in the edit frame
sub apply {
	my $self = shift;

	foreach my $selection ($self->{list}->selectionGet()) {

        my $path = $self->getPath($selection);
        my $ref = $self->getPathRef($path);
        my $name = pop @{$path};
        my $parentRef = $self->getPathRef($path);

		my $value = '';
		if (hashref($parentRef)) {
    		$value = $parentRef->{$name};
		} elsif (arrayref($parentRef)) {
    		$value = $parentRef->[$name];
		}
		
        $self->refreshItem($name);
	}
}



# Only need to update path
sub browse {
    my $self = shift;

    $self->{parent}->updatePath($self->getSelectedPath());
}



sub closeItem {
    my $self = shift;
    my $item = shift;
    my $ref  = shift;


	$self->{list}->entryconfigure($item, 
		                          -state  => 'close',
		                          -image => $self->{parent}->getIcon('close', refType($ref)));

    # Remove children
	foreach my $child (reverse $self->{list}->info('children', $item)) {
		$self->removeItem($child);
	}
}



sub copyItem {
	my $self = shift;
	my $item = shift;

    my $path = $self->getPath($item);
    my $name = pop @{$path};

    my $ref = $self->getPathRef($path);

    # Copy data to clipboard
    if (arrayref($ref)) {
        push @{$self->{clipboard}{'@'}}, $ref->[$name];
    } elsif (hashref($ref)) {
        $self->{clipboard}{'%'}{$name} = $ref->{$name};
    }
}



sub copySelectedItems {
    my $self = shift;    
    my $selected = $self->{list}->info('selection'); 

    $self->{clipboard} = {};
    
    for my $selection (@{$selected}) {
        $self->copyItem($selection);       
    }
}



sub cutSelectedItems {
    my $self = shift;    
    my $selected = $self->{list}->info('selection'); 

    $self->{clipboard} = [];
    
    for my $selection (@{$selected}) {
        $self->copyItem($selection);        
        $self->deleteItem($selection);        
    }
}



# L@@K need to fix for scalar
sub defineItem {
	my $self  = shift;
	my $type = shift;

	foreach my $selection (reverse $self->{list}->selectionGet())  {
        my $path = $self->getPath($selection);
        my $name = pop @{$path};
        my $parentRef = $self->getPathRef($path);
        
		$self->setData($parentRef, $name, $type);
        $self->refreshItem($selection);
    }
}



sub deleteItem {
	my $self  = shift;
	my $item = shift;

	return unless defined $item;
	$self->deleteItemData($item);

    # Removes item from HList gui
    $self->removeItem($item);
}



sub deleteItemData {
	my $self = shift;
	my $item = shift;

    my $path = $self->getPath($item);
    my $name = pop @{$path};

    my $ref = $self->getPathRef($path);

    # Removes data
    if (arrayref($ref)) {
        splice (@{$ref}, $name, 1);
    } elsif (hashref($ref)) {
	    delete ($ref->{$name});
    }
}



sub deleteSelectedItems {
    my $self = shift;    
    my $selected = $self->{list}->info('selection'); 

    # Have to delete in reverse order, because we can not
    # delete array index 1 before index 2
    for my $selection (reverse @{$selected}) {
        my $path = $self->getPath($selection);
        my $key  = pop @{$path};
        my $parentRef = $self->getPathRef($path);

        $self->deleteItem($selection);

        if (arrayref($parentRef)) {
            $self->refreshItemChildren(join($SEP, @{$path}));
        }
    }
}



sub frame {
    my $self = shift;
    
	$self->{frame} = $self->{parent}{MW}->Frame();

	$self->{list} = $self->{frame}->Scrolled('HList',
									  -itemtype   => 'imagetext',
									  -command    => sub {$self->select()},
									  -browsecmd  => sub {$self->browse()},
									  -separator  => $SEP,
									  -indent     => 20,
									  -selectmode => 'extended',
									  -scrollbars => 'osoe',
									  -columns    => 2,
									  -header     => 2,
									  -bg         => 'grey',
									  -fg         => 'black',
									  )->pack(-fill => 'both', -expand => 1);

	$self->{list}->header('create', 0, -text=> 'key');
	$self->{list}->header('create', 1, -text=> 'value');
	$self->{list}->bind("<3>", [sub {$self->popup}]);
}



sub getApplication {
    my $self = shift;

    return $self->{application} if $self->{application};

    $self->{application} = $self->{parent}->getApplication();
    return $self->{application};
}



sub getChildren {
	my $self = shift;
	my $ref  = shift;

    my $children = [];
    if (hashref($ref)) {
        $children = [sort keys %{$ref}];
    } elsif (arrayref($ref)) {
        $children = [0..$#$ref];
        
    }
	return $children;
}



sub getData {
	my $self = shift;
    
    return $self->getApplication()->getData();
}



sub getRoot {
	my $self = shift;
    
    return $self->getData()->getRoot();
}



sub getEditValue {
    my $self = shift;
    my $field = shift || 'value';
    
    return $self->{parent}->getEdit()->getValue($field);
}



sub getItemRef {
	my $self = shift;
    my $item = shift;
    
    my $path = $self->getPath($item);
	return $self->getPathRef($path);
}



sub getPath {
    my $self = shift;
    my $path = shift;
    return [split /$SEP/, $path];    
}



sub getPathRef {
	my $self = shift;
	my @path = @{shift()};

	my $ref = $self->getRoot();

	foreach my $pp (@path) {
		if (arrayref($ref)) {
			$ref = $ref->[$pp];
		} elsif (hashref($ref)) {
			$ref = $ref->{$pp};
		}
	}
	
	return $ref;
}



sub getSelectedItem {
    my $self = shift;
    my $ndx  = shift || 0;
    return @{$self->{list}->info('selection')}[$ndx];
}



sub getSelectedItemRef {
	my $self = shift;
	
	my @path = @{$self->getSelectedPath()};
	my $ref = $self->getRoot();

	foreach my $pp (@path) {
		if (arrayref($ref)) {
			$ref = $ref->[$pp];
		} elsif (hashref($ref)) {
			$ref = $ref->{$pp};
		}
	}
	
	return $ref;
}



sub getSelectedPath {
    my $self = shift;
    my $ndx  = shift || 0;
    my @selectionList = @{$self->{list}->info('selection')};
    if (scalar @selectionList) {
        return [split /$SEP/, $selectionList[$ndx]];        
    } else {
        return undef;
    }
}



sub getRefKeys {
    my $self = shift;
    my $ref  = shift;
    
    my $keys = [];
    if (arrayref($ref)) {
        $keys = [0..$#{$ref}];
    } elsif (hashref($ref)) {
        $keys = [sort keys %{$ref}];
    }

    return $keys;
}



# Populates root only
sub initialize {
	my $self = shift;

	# Clear first
	$self->{list}->deleteAll;

	foreach my $key (@{$self->getRefKeys($self->getRoot())}) {
		$self->addListItem($key);
	}
}



sub insert {
	my $self     = shift;
	my $location = shift;
	my $type     = shift;

    # We can only insert on selected values
	my @selected = $self->{list}->selectionGet();
	return unless (scalar @selected);

	my $value = $self->getEditValue('value');

	foreach my $selection (reverse @selected)  {
		my $v  = $value;

        my $path = $self->getPath($selection);
        my $ref = $self->getPathRef($path);
        my $name = pop @{$path};
        my $parentRef = $self->getPathRef($path);

        # We can only "insert" to an array
		next unless arrayref($parentRef);

        my $ndx = $name;
        if ($location eq 'Before') {
        } elsif ($location eq 'After') {
            $ndx++;
        } elsif ($location eq 'At Index') {
            $ndx = $self->getEditValue('key');
            if ($ndx !~ /^\d+$/) {
                print STDERR "Invalid index given '$ndx'\n";
                next;
            }
        } else {
            print STDERR "Can not insert without location\n";
        }


        my $value = $self->getEditValue('value');
        if ($type eq '@') {
            $value = [];
        } elsif ($type eq '%') {
            $value = {};
        }

        # This splices in the new data.
        # L@@K need to implement better using OOP
        my $end = scalar @{$parentRef};        
        if ($ndx < $end) {
            splice(@{$parentRef}, $ndx, 0, $value);
        } else {
            $parentRef->[$ndx] = $value;
            $end = $ndx;
        }
        
        for my $childNdx (0..$end) {
            my $name = join($SEP, @{$path}, $childNdx);
            $self->addListItem($name);
            $self->refreshItem($name);
        }
	}
}



sub hide {
    my $self = shift;    
	$self->{frame}->packForget();
}



sub leaf {
    my $item = shift;
    return (split /$SEP/, $item)[-1];
}



sub openItem {
    my $self = shift;
    my $item = shift;
    my $ref  = shift;
    
    # Open if closed or half open
	$self->{list}->entryconfigure($item, 
	                              -state => 'open', 
	                              -image => $self->{parent}->getIcon('open', refType($ref)));

    # Add children to open item
	foreach my $child (@{$self->getChildren($ref)}) {
	    $self->addListItem("$item$SEP$child");
    }
}



sub paste {
	my $self = shift;

    return unless (defined $self->{clipboard});

	my @selected = $self->{list}->selectionGet();
    
    return unless (scalar @selected);

    foreach my $selection (reverse @selected)  {
        my $path      = $self->getPath($selection);
        my $ref       = $self->getPathRef($path);
        my $child     = pop(@{$path});
        my $parentRef = $self->getPathRef($path);
        
        if (arrayref($ref)) {
            push @{$ref}, @{dclone($self->{clipboard}{'@'})};
        }
        
        if (hashref($ref)) {
            %{$ref} = (%{dclone($self->{clipboard}{'%'})}, %{$ref});
        }
        
        $self->openItem($selection, $ref);
    }
}



########################################
# popup
# Create the HList popup menu for right mouse button
#
sub popup {
	my $self = shift;

	my @selected = $self->{list}->selectionGet;
    my $needsSelection = scalar(@selected) ? 'normal' : 'disabled';
	my %state = (add      => $needsSelection,
				 delete   => $needsSelection,
				 undef    => $needsSelection,
				 cut_copy => $needsSelection,
				 rename   => $needsSelection,
				 insert   => 'disabled',
				 paste    => $needsSelection,
				 define   => $needsSelection);


	# Determine enabled/disabled menus
	my $ccp = '';
	foreach my $s (@selected) {
	    my $path      = $self->getPath($s);
        my $ref       = $self->getPathRef($path);
        my $child     = pop(@{$path});
        my $parentRef = $self->getPathRef($path);

		$ccp = $parentRef unless $ccp;

		$state{cut_copy} = 'disabled' unless ($ccp eq $parentRef);

		$state{insert} = 'normal' if arrayref($parentRef);
		$state{rename} = 'normal' if hashref($parentRef);
		$state{paste}  = $state{add} = 'normal' if ((hashref($ref)) or (arrayref($ref)));
		$state{define} = 'disabled' if (defined $ref);
		$state{undef}  = 'disabled' if (not defined $ref);
	}

    $state{rename} = 'disabled' unless $self->getEditValue('key');
	$state{paste}  = 'disabled' unless (defined $self->{clipboard});

	# Build menu
	my $menu = $self->{parent}{MW}->Menu(-tearoff => 0);

	#################################################################
	# Add/Delete/Undef

	# Add menu can add scalars, arrays and hashes
	my $addm = $menu->Menu(-tearoff => 0);

	foreach my $type (['$', 'Scalar'], ['@', 'Array'], ['%', 'Hash']) {
		$addm->command(-label => $type->[1], -command => [sub {$self->add($type->[0])}]);
	}

	$menu->add('cascade', -label => 'Add', -state => $state{add}, -menu => $addm);

	# Delete/Undef works the same for any type
	$menu->add('command', -label => 'Delete', -state => $state{delete}, -command => [sub {$self->deleteSelectedItems()}]);

	my $defm = $menu->Menu(-tearoff => 0);

	foreach my $type (['@', 'Array'], ['%', 'Hash']) {
		$defm->command(-label => $type->[1], -command => [sub {$self->defineItem($type->[0])}]);
	}

	$menu->add('cascade', -label => 'Define', -state => $state{define}, -menu => $defm);

	$menu->add('command', -label => 'Undef',  -state => $state{undef}, -command => [sub {$self->undefSelectedItems()}]);

	$menu->separator();

	#################################################################
	# Insert/Rename

	# Insert is only valid if we are in an array, but we can insert any type; before, after or at an element
	my $insm = $menu->Menu(-tearoff => 0);
		
	foreach my $location ('Before', 'After', 'At Index') {
		my $sm = $menu->Menu(-tearoff => 0);
		foreach my $type (['$', 'Scalar'], ['@', 'Array'], ['%', 'Hash']) {
			$sm->command(-label => $type->[1], -command => [sub {$self->insert($location, $type->[0])}]);
		}
		$insm->add('cascade', -label => "$location", -menu => $sm);
	}
	$menu->add('cascade', -label => 'Insert', -state => $state{insert}, -menu => $insm);

	# Rename only works if we are in a hash
	$menu->add('command', -label => 'Rename', -state => $state{rename}, -command => [sub {$self->renameSelectedItems()}]);
	$menu->add('command', -label => 'Apply', -command => [sub {$self->apply()}]);


	$menu->separator();

	#################################################################
	# Cut/Copy/Paste
	$menu->command(-label   => 'Cut',   -state => $state{cut_copy}, -command => [sub {$self->cutSelectedItems()}]);
	$menu->command(-label   => 'Copy',  -state => $state{cut_copy}, -command => [sub {$self->copySelectedItems()}]);
	$menu->command(-label   => 'Paste', -state => $state{paste},    -command => [sub {$self->paste}]);

	# Instantiate popup
	$menu->Popup(-overanchor => 'nw', -popanchor  => 'nw', -popover    => 'cursor');

}



sub refreshItem {
    my $self = shift;
    my $item = shift;

    my $ref = $self->getItemRef($item);
    my $state = $self->{list}->entrycget($item, -state);
    $self->{list}->entryconfigure($item, 
		                          -state  => $state,
		                          -image => $self->{parent}->getIcon($state, refType($ref)));

    $self->refreshValueColumn($item, $ref);
}



sub refreshItemChildren {
    my $self = shift;
    my $item = shift;
    
    my $ref = $self->getItemRef($item);
    my $ndx = 0;

	foreach my $child ($self->{list}->info('children', $item)) {
        if (ref($self->getItemRef($child))) {
            $self->refreshItemChildren($child);           
        }
        
        if (arrayref($ref)) {
            $self->removeItem($child);
            $self->addListItem("$item$SEP$ndx");
        } else {
            $self->refreshItem($child);
        }

        $ndx++;
	}
}



sub refreshValueColumn {
    my $self = shift;
    my $item = shift;
    my $ref  = shift;

    if ($self->{list}->itemExists($item, 1)) {
        $self->{list}->itemDelete($item, 1);
    }

	unless (ref $ref) {
		my $widget;
		if (defined $ref) { 
			$widget = $self->{list}->Entry(-textvariable => $ref, -width => 75);
		} else {
			$widget = $self->{list}->Label(-text => '<undef>', -bg => 'grey');
		}
		$self->{list}->itemCreate($item, 1, -itemtype => 'window', -widget => $widget);
	}

};



sub removeItem {
	my $self  = shift;
	my $item = shift;

	return unless defined $item;

    # Removes item from HList gui
	$self->{list}->delete('entry', $item) ;
}



sub renameSelectedItems {
    my $self = shift;

    my $name = $self->getEditValue('key');

    unless ($name) {
        $self->{parent}{MW}->Error("No new key specified");
        return;
    }

    my @selected = $self->{list}->selectionGet();

    for my $selection (@selected) {
        my $path = $self->getPath($selection);
        pop @{$path};
        my $value = $self->getItemRef($selection);
        my $new = join($SEP, @{$path}, $name);
        
        # Unfortunately we can not reassign the "path" for 
        # a hlist item. Therefore we have to delete it and
        # re-add it
 		$self->deleteItem($selection);
		$self->addData($new, $value);
		
		# L@@K The following doesn't work like it should
#        $self->refreshItemChildren($path);
	
    }
    
}



sub select {
	my $self = shift;

	# Important stuff
	my $list = $self->{list};
	my $item = $self->getSelectedItem();

	# Get state, return if undefined or a leaf
	my $state = $list->entrycget($item, -state);
#	return if ((!defined $state) or ($state eq 'leaf'));

	# Walk the data structure given the current item path to get a ref
	my $ref  = $self->getSelectedItemRef();

	# Close if open
    if (ref($ref)) {
    	if ($state eq 'open') {
            $self->closeItem($item, $ref);
    	} else {
            $self->openItem($item, $ref);
    	}
    }
}



# Via the "Define" popup menu
sub setData {
	my $self = shift;
	my $ref  = shift;
	my $ndx  = shift;
	my $type = shift;

    # If it happens to be a scalar
	my $value = $self->getEditValue('value');
	$value = [] if $type eq '@';
	$value = {} if $type eq '%';
	
	$ref->{$ndx} = $value if hashref($ref);
	$ref->[$ndx] = $value if arrayref($ref);
}



sub show {
    my $self = shift;    
	$self->{frame}->pack(-expand => 1, -side => 'top', -fill => 'both');
}



sub undefItem {
	my $self = shift;
	my $item = shift;

    my $path = $self->getPath($item);
    my $name = pop @{$path};

    my $ref = $self->getPathRef($path);

    # Removes data
    if (arrayref($ref)) {
        $ref->[$name] = undef;
    } elsif (hashref($ref)) {
        $ref->{$name} = undef;
    }
    
    $self->refreshItem($item);
}



sub undefSelectedItems {
    my $self = shift;    
    my $selected = $self->{list}->info('selection'); 

    for my $selection (@{$selected}) {
        $self->undefItem($selection);        
    }    
}



1;

__END__
